home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Interfaces & Libraries / Interfaces / AIncludes / ObjMacros.a < prev    next >
Encoding:
Text File  |  1993-12-02  |  12.3 KB  |  457 lines  |  [TEXT/MPS ]
  1. ;    File:        ObjMacros.a
  2. ;
  3. ;    Copyright:    © 1983-1993 by Apple Computer, Inc.
  4. ;                All rights reserved.
  5. ;
  6. ;    Version:    System 7.1 for ETO #11
  7. ;    Created:    Tuesday, March 30, 1993 18:00
  8. ;
  9. ;___________________________________________________________________________
  10.  
  11.     IF &TYPE('__INCLUDINGOBJMACROS__') = 'UNDEFINED' THEN
  12. __INCLUDINGOBJMACROS__    SET    1
  13.  
  14.  
  15.                   IMPORT      %_METHOD
  16.                   IMPORT      %_OBNEW
  17.                   IF          &TYPE('ObjOptFlag') = 'UNDEFINED' THEN
  18. ObjOptFlag:       EQU         0
  19.                   ENDIF
  20.                   IF          &TYPE('DebugFlag') = 'UNDEFINED' THEN
  21. DebugFlag:        EQU         1
  22.                   ENDIF
  23.  
  24.  
  25.                   MACRO
  26.                   REFSELECTOR &ProcName,&ItsObjIndex,&OpCode
  27.  
  28.                   GBLA        &ObjSupers[250],&MethLists[250], &MethTable
  29.                   GBLC        &ObjNames[250]
  30.  
  31.                   LCLA        &start,&found,&objIndex,&LexInt
  32.  
  33.                   &found:     SETA 0
  34.                   IF          &FINDSYM(&MethTable,&ProcName) THEN
  35.                   &start:     SETA 1
  36.                   GOTO        .EndLoop
  37.                   WHILE       &SYSTOKEN <> 30 DO
  38.                   &LexInt:    SETA &S2I(&SYSTOKSTR)
  39.                   &objIndex:  SETA &ItsObjIndex
  40.                   WHILE       (&objIndex <> 0) DO
  41.                   IF          &LexInt = &objIndex THEN
  42.                   &OpCode     &ObjNames[&objIndex]$&ProcName
  43.                   &objIndex:  SETA 0
  44.                   &found:     SETA 1
  45.                   ELSE
  46.                   &objIndex:  SETA &ObjSupers[&objIndex]
  47.                   ENDIF
  48.                   ENDWHILE
  49. .EndLoop
  50.                   &start:     SETA &LEX(&SYSVALUE, &start)
  51.                   WHILE       (&SYSTOKEN <> 1) AND (&SYSTOKEN <> 30) DO
  52.                   &start:     SETA &LEX(&SYSVALUE, &start)
  53.                   ENDWHILE
  54.                   ENDWHILE
  55.                   ENDIF
  56.  
  57.                   IF          &found = 0 THEN
  58.                   AERROR      &Concat('Error trying to reference method: ',&ProcName)
  59.                   ENDIF
  60.  
  61.                   ENDMACRO
  62.  
  63.                   MACRO
  64.                   SELECTORPROC &ProcName
  65.                   LCLC        &SaveSeg
  66.                   &SaveSeg:   SETC &SYSSEG
  67.                   SEG         '%_SelProcs'
  68.                   &ProcName:  PROC EXPORT
  69.                   JSR         %_METHOD
  70.                   ENDPROC
  71.                   SEG         '&SaveSeg'
  72.                   ENDMACRO
  73.  
  74.  
  75.  
  76.                   MACRO
  77.                   ObjectTemplate &TypeName,&Heritage=NIL,&IntfOnly:INT=0
  78.  
  79.                   GBLA        &ObjSupers[250],&MethLists[250]
  80.                   GBLC        &ObjNames[250]
  81.                   GBLA        &lastObjIndex, &currMethIndex, &MethTable
  82.  
  83.                   GBLA        &NumFields,&NumMethods
  84.                   GBLC        &FieldList[250],&MethodList[250]
  85.  
  86.                   LCLA        &methNum, &fieldNum, &objIndex
  87.                   LCLC        &SaveSeg, &RootIndex
  88.                   LCLA        &SuperIndex, &NumChars, &Temp
  89.                   LCLA        &methIndex, &foundIndex, &MethFlag, &SymReturn
  90.  
  91.                   LCLC        &TempArray[1],&CurrField[2],&CurrMethod[3]
  92.  
  93.                   IF          &MethTable = 0 THEN
  94.                   &MethTable: SETA &NEWSYMTBL
  95.                   ENDIF
  96.  
  97.                   &lastObjIndex: SETA &lastObjIndex+1
  98.                   &ObjNames[&lastObjIndex]: SETC &TypeName
  99.                   &MethLists[&lastObjIndex]: SETA &currMethIndex+1
  100.                   IF          (&Heritage = 'NIL') THEN
  101.                   &ObjSupers[&lastObjIndex]: SETA 0
  102.                   ELSE
  103.                   &SuperIndex: SETA 1
  104.                   &ObjNames[&lastObjIndex+1]: SETC &Heritage
  105.                   WHILE       (&ObjNames[&SuperIndex] <> &Heritage) DO
  106.                   &SuperIndex: SETA &SuperIndex+1
  107.                   ENDWHILE
  108.                   IF          (&SuperIndex > &lastObjIndex) THEN
  109.                   AERROR      &Concat('Non-existent Ancestor Object Type: ',&Heritage)
  110.                   ELSE
  111.                   &ObjSupers[&lastObjIndex]: SETA &SuperIndex
  112.                   ENDIF
  113.                   ENDIF
  114.  
  115.                   IF          &NumFields >= 0 THEN
  116.                   &fieldNum:  SETA 1
  117.                   %&TypeName: RECORD &Heritage.Offset
  118.                   WHILE       &fieldNum <= &NumFields DO
  119.                   &NumChars:  SETA &LEN(&FieldList[&fieldNum])-2
  120.                   &Temp:      SETA &LIST(&FieldList[&fieldNum,2:&NumChars], '&CurrField')
  121.                   IF          &Eval(&CurrField[2]) >= 2 THEN
  122.                   ALIGN       2
  123.                   ENDIF
  124.                   &CurrField[1]: DS.B &CurrField[2]
  125.                   &fieldNum:  SETA &fieldNum+1
  126.                   ENDWHILE
  127.                   ALIGN       2
  128.                   last:       EQU *
  129.                   ENDR
  130.                   &TypeName.Offset: EQU %&TypeName..last
  131.                   ENDIF
  132.  
  133.                   IF          &NumMethods > 0 THEN
  134.                   &methNum:   SETA 1
  135.                   WHILE       &methNum <= &NumMethods DO
  136.                   &NumChars:  SETA &LEN(&MethodList[&methNum])-2
  137.                   &CurrMethod[2]: SETC ''
  138.                   &CurrMethod[3]: SETC ''
  139.                   &Temp:      SETA &LIST(&MethodList[&methNum,2:&NumChars], '&CurrMethod')
  140.                   IF          (&CurrMethod[2] = '') OR (&UC(&CurrMethod[2]) = 'IMPL') THEN
  141.                   IF          (&UC(&CurrMethod[2]) = 'IMPL') THEN
  142.                   IF          &IntfOnly THEN
  143.                   IMPORT      &TypeName.$&CurrMethod[1]
  144.                   ELSE
  145.                   AERROR      &Concat('IMPL only allowed in ObjectIntf Macro. Error at ', \
  146.                   &CurrMethod[1],' in ',&TypeName)
  147.                   ENDIF
  148.                   ELSEIF      &IntfOnly THEN
  149.                   IMPORT      &TypeName.$&CurrMethod[1]
  150.                   ELSE
  151.                   SELECTORPROC &TypeName.$&CurrMethod[1]
  152.                   ENDIF
  153.                   &currMethIndex: SETA &currMethIndex+1
  154.                   &SymReturn: SETA &ENTERSYM(&MethTable,&I2S(&currMethIndex),&CurrMethod[1],0)
  155.  
  156. *                 First       do findsym to see if other unrelated root classes
  157.                   IF          &FINDSYM(&MethTable,&CurrMethod[1]) THEN
  158.                   &RootIndex: SETC &Concat(&SYSVALUE,' ',&I2S(&lastObjIndex))
  159.                   &MethFlag:  SETA &SYSFLAGS+1
  160.                   ELSE
  161.                   &RootIndex: SETC &I2S(&lastObjIndex)
  162.                   &MethFlag:  SETA 1
  163.                   ENDIF
  164.                   &SymReturn: SETA &ENTERSYM(&MethTable,&CurrMethod[1],&RootIndex,&MethFlag)
  165.                   ELSEIF      (&UC(&CurrMethod[2]) <> 'OVERRIDE') THEN
  166.                   AERROR      &Concat(&CurrMethod[2],' illegal after ',&CurrMethod[1], \
  167.                   '           in ',&TypeName)
  168.                   ENDIF
  169.                   IF          NOT &IntfOnly THEN
  170.                   EXPORT      &TypeName._&CurrMethod[1]
  171.                   ELSEIF      (&UC(&CurrMethod[2]) = 'IMPL') OR (&UC(&CurrMethod[3]) = 'IMPL') THEN
  172.                   EXPORT      &TypeName._&CurrMethod[1]
  173.                   ELSE
  174.                   IMPORT      &TypeName._&CurrMethod[1]
  175.                   ENDIF
  176.                   &methNum:   SETA &methNum+1
  177.                   ENDWHILE
  178.  
  179.                   IF          NOT &IntfOnly THEN
  180.                   &SaveSeg:   SETC &SYSSEG
  181.                   SEG         '%_MethTables'
  182.                   CODEREFS    FORCEJT
  183.                   _&TypeName: PROC EXPORT
  184.                   DC.W        _&TypeName
  185.                   IF          &Heritage = 'NIL' THEN
  186.                   DC.W        0
  187.                   ELSE
  188.                   DC.W        _&Heritage
  189.                   ENDIF
  190.                   DC.W        &TypeName.Offset
  191.                   DC.W        &methNum-1
  192.                   &methNum:   SETA 1
  193.                   WHILE       &methNum <= &NumMethods DO
  194.                   &NumChars:  SETA &LEN(&MethodList[&methNum])-2
  195.                   &CurrMethod[2]: SETC ''
  196.                   &CurrMethod[3]: SETC ''
  197.                   &Temp:      SETA &LIST(&MethodList[&methNum,2:&NumChars], '&CurrMethod')
  198.                   IF          (&CurrMethod[2] = '') THEN
  199.                   DC.W        &TypeName.$&CurrMethod[1]
  200.                   ELSEIF      (&UC(&CurrMethod[2]) = 'OVERRIDE') THEN
  201.                   IF          &superIndex = 0 THEN
  202.                   AERROR      &Concat('Override of Non-existent method: ',&CurrMethod[1])
  203.                   ELSE
  204.                   REFSELECTOR &CurrMethod[1],&superIndex,DC.W
  205.                   ENDIF
  206.                   ENDIF
  207.                   IMPORT      &TypeName._&CurrMethod[1]
  208.                   DC.W        &TypeName._&CurrMethod[1]
  209.                   &methNum:   SETA &methNum+1
  210.                   ENDWHILE
  211.                   ENDPROC
  212.                   SEG         '&SaveSeg'
  213.                   CODEREFS    NOFORCEJT
  214.                   ELSE
  215.                   IMPORT      _&TypeName
  216.                   ENDIF
  217.                   ENDIF
  218.                   &MethLists[&lastObjIndex+1]: SETA &currMethIndex+1
  219.                   ENDMACRO
  220.  
  221.  
  222.                   MACRO
  223.                   ObjectDef   &TypeName,&Heritage=NIL
  224.  
  225.                   GBLA        &NumFields,&NumMethods
  226.                   GBLC        &FieldList[250],&MethodList[250]
  227.  
  228.                   LCLA        &index1, &index2
  229.  
  230.                   &index1:    SETA 3
  231.                   &index2:    SETA 1
  232.                   WHILE       &NBR(&SYSLIST[&index1]) <> 0 DO
  233.                   &FieldList[&index2]: SETC &SYSLIST[&index1]
  234.                   &index1:    SETA &index1+1
  235.                   &index2:    SETA &index2+1
  236.                   ENDWHILE
  237.                   &NumFields: SETA &index2-1
  238.  
  239.                   &index2:    SETA 1
  240.                   IF          &SYSLIST[&index1] = 'METHODS' THEN
  241.                   &index1:    SETA &index1+1
  242.                   WHILE       &NBR(&SYSLIST[&index1]) <> 0 DO
  243.                   &MethodList[&index2]: SETC &SYSLIST[&index1]
  244.                   &index1:    SETA &index1+1
  245.                   &index2:    SETA &index2+1
  246.                   ENDWHILE
  247.                   ENDIF
  248.                   &NumMethods: SETA &index2-1
  249.  
  250.                   ObjectTemplate &TypeName,&Heritage,0
  251.                   ENDMACRO
  252.  
  253.  
  254.                   MACRO
  255.                   ObjectIntf  &TypeName,&Heritage=NIL
  256.  
  257.                   GBLA        &NumFields,&NumMethods
  258.                   GBLC        &FieldList[250],&MethodList[250]
  259.  
  260.                   LCLA        &index1, &index2
  261.  
  262.                   &index1:    SETA 3
  263.                   &index2:    SETA 1
  264.                   WHILE       &NBR(&SYSLIST[&index1]) <> 0 DO
  265.                   &FieldList[&index2]: SETC &SYSLIST[&index1]
  266.                   &index1:    SETA &index1+1
  267.                   &index2:    SETA &index2+1
  268.                   ENDWHILE
  269.                   &NumFields: SETA &index2-1
  270.  
  271.                   &index2:    SETA 1
  272.                   IF          &SYSLIST[&index1] = 'METHODS' THEN
  273.                   &index1:    SETA &index1+1
  274.                   WHILE       &NBR(&SYSLIST[&index1]) <> 0 DO
  275.                   &MethodList[&index2]: SETC &SYSLIST[&index1]
  276.                   &index1:    SETA &index1+1
  277.                   &index2:    SETA &index2+1
  278.                   ENDWHILE
  279.                   ENDIF
  280.                   &NumMethods: SETA &index2-1
  281.  
  282.                   ObjectTemplate &TypeName,&Heritage,1
  283.                   ENDMACRO
  284.  
  285.  
  286.  
  287.                   MACRO
  288.                   OBJECTWITH  &TypeName
  289.                   GBLA        &WithLevel[8]
  290.                   GBLA        &WithIndex
  291.                   GBLA        &ObjSupers[*]
  292.                   GBLC        &ObjNames[*]
  293.                   GBLA        &lastObjIndex
  294.  
  295.                   GBLC        &currObjName,&currSuperName
  296.                   GBLA        &currObjIndex
  297.  
  298.                   LCLA        &SuperIndex
  299.                   &currObjName: SETC &TypeName
  300.                   &SuperIndex: SETA 1
  301.                   &ObjNames[&lastObjIndex+1]: SETC &TypeName
  302.                   WHILE       &ObjNames[&SuperIndex] <> &TypeName DO
  303.                   &SuperIndex: SETA &SuperIndex+1
  304.                   ENDWHILE
  305.                   &currObjIndex: SETA &SuperIndex
  306.                   IF          &SuperIndex > &lastObjIndex THEN
  307.                   AERROR      &Concat('Object Type name does not exist: ',&TypeName)
  308.                   ELSE
  309.                   IF          &ObjSupers[&SuperIndex] = 0 THEN
  310.                   &currSuperName: SETC 'NIL'
  311.                   ELSE
  312.                   &currSuperName: SETC &ObjNames[&ObjSupers[&SuperIndex]]
  313.                   ENDIF
  314.                   WITH        %&TypeName
  315.                   &WithIndex: SETA &WithIndex+1
  316.                   WHILE       &ObjSupers[&SuperIndex] <> 0 DO
  317.                   WITH        %&ObjNames[&ObjSupers[&SuperIndex]]
  318.                   &WithLevel[&WithIndex]: SETA &WithLevel[&WithIndex]+1
  319.                   &SuperIndex: SETA &ObjSupers[&SuperIndex]
  320.                   ENDWHILE
  321.                   ENDIF
  322.                   ENDMACRO
  323.  
  324.                   MACRO
  325.                   METHOD      &MethName,&TypeName,&FuncORProc=PROC
  326.                   &TypeName._&MethName: &FuncORProc EXPORT
  327.                   OBJECTWITH  &TypeName
  328.                   ENDMACRO
  329.  
  330.                   MACRO
  331.                   &MethName:  ProcMethOf &TypeName
  332.                   METHOD      &MethName,&TypeName,PROC
  333.                   ENDMACRO
  334.  
  335.                   MACRO
  336.                   &MethName:  FuncMethOf &TypeName
  337.                   METHOD      &MethName,&TypeName,FUNC
  338.                   ENDMACRO
  339.  
  340.                   MACRO
  341.                   ObjectEndWith
  342.                   ENDWITH
  343.                   GBLA        &WithLevel[*]
  344.                   GBLA        &WithIndex
  345.                   IF          &WithIndex > 0 THEN
  346.                   WHILE       &WithLevel[&WithIndex] > 0 DO
  347.                   ENDWITH
  348.                   &WithLevel[&WithIndex]: SETA &WithLevel[&WithIndex]-1
  349.                   ENDWHILE
  350.                   &WithIndex: SETA &WithIndex-1
  351.                   ENDIF
  352.                   ENDMACRO
  353.  
  354.  
  355.                   MACRO
  356.                   ENDMETHOD
  357.                   ObjectEndWith
  358.                   ENDPROC
  359.                   ENDMACRO
  360.  
  361.  
  362.                   MACRO
  363.                   METHCALL    &MethName,&ObjTypeName
  364.                   GBLC        &ObjNames[*]
  365.                   GBLA        &currObjIndex, &lastObjIndex
  366.  
  367.                   LCLA        &objIndex
  368.                   IF          &ObjTypeName = '' THEN
  369.                   &objIndex:  SETA &currObjIndex
  370.                   ELSE
  371.                   &objIndex:  SETA 1
  372.                   &ObjNames[&lastObjIndex+1]: SETC &ObjTypeName
  373.                   WHILE       &ObjNames[&objIndex] <> &ObjTypeName DO
  374.                   &objIndex:  SETA &objIndex+1
  375.                   ENDWHILE
  376.                   ENDIF
  377.                   IF          &objIndex > &lastObjIndex THEN
  378.                   AERROR      &Concat('Unknown Object type Name: ',&ObjTypeName)
  379.                   ELSEIF      ObjOptFlag THEN
  380.                   JSR         &ObjNames[&objIndex]$&MethName
  381.                   ELSE
  382.                   REFSELECTOR &MethName,&objIndex,JSR
  383.                   ENDIF
  384.                   ENDMACRO
  385.  
  386.                   MACRO
  387.                   INHERITED   &MethName
  388.                   GBLC        &ObjNames[*]
  389.                   GBLA        &ObjSupers[*]
  390.                   GBLA        &currObjIndex
  391.  
  392.                   LCLA        &objIndex
  393.  
  394.                   &objIndex:  SETA &ObjSupers[&currObjIndex]
  395.                   WHILE       (&TYPE(&Concat(&ObjNames[&objIndex],'_',&MethName)) = 'UNDEFINED') AND (&objIndex <> 0) DO
  396.                   &objIndex:  SETA &ObjSupers[&objIndex]
  397.                   ENDWHILE
  398.                   IF          &objIndex = 0 THEN
  399.                 AERROR &Concat('Inherited error; Method not defined in ancestor: ',&MethName)
  400.                   ELSE
  401.                   IMPORT      &ObjNames[&objIndex]_&MethName
  402.                   JSR         &ObjNames[&objIndex]_&MethName
  403.                   ENDIF
  404.                   ENDMACRO
  405.  
  406.  
  407.                   MACRO
  408.                   MoveSelf    &Dest
  409.                   MOVE.L      8(A6),&Dest
  410.                   ENDMACRO
  411.  
  412.  
  413.                   MACRO
  414.                   NewObject   &Loc,&TypeName,&Size
  415.                   PEA         &Loc
  416.                   PEA         _&TypeName+2
  417.                   IF          &Size = '' THEN
  418.                   MOVE.W      #&TypeName.Offset,-(SP)
  419.                   ELSE
  420.                   MOVE.W      #&Size,-(SP)
  421.                   ENDIF
  422.                   JSR         %_OBNEW
  423.                   ENDMACRO
  424. *                 The         InitObjects macro must be called if the main program is not in Pascal
  425.  
  426.                   IMPORT      %_PGM1
  427.  
  428.                   MACRO
  429.                   InitObjects
  430.  
  431.                   JSR         %_PGM1
  432.                   ENDMACRO
  433.  
  434.  
  435. NILOffset         EQU         2
  436.  
  437.                   IF          DebugFlag THEN
  438.  
  439.                   ObjectIntf  TObject,, \ Suggested root class for all objects
  440.                   METHODS,    \ no data fields
  441.                 (ShallowClone), \ Object copying method; rarely overridden
  442.                 (Clone), \ Can be overriden to clone fields
  443.                 (ShallowFree), \ Frees object; rarely overridden
  444.                   (Free),     \ Can be overriden to free fields
  445.                   (ClassName), \ Returns name of class
  446.                   (Inspect)                             ; Print info to debug window
  447.                   ELSE
  448.                   ObjectIntf  TObject,, \ Suggested root class for all objects
  449.                   METHODS,    \ no data fields
  450.                 (ShallowClone), \ Object copying method; rarely overridden
  451.                 (Clone), \ Can be overriden to clone fields
  452.                 (ShallowFree), \ Frees object; rarely overridden
  453.                 (Free) ; Can be overriden to free fields
  454.                 
  455.                 ENDIF
  456.  
  457.     ENDIF    ; ...already included